home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Games Machine 131
/
XENIATGM131.iso
/
Shareware
/
openOffice.org 641
/
Windows
/
f_0183
/
ModuleControls.xba
< prev
next >
Wrap
Extensible Markup Language
|
2001-11-20
|
10KB
|
290 lines
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="ModuleControls" script:language="StarBasic">Option Explicit
'bla
' Accepts the name of a control and returns the respective control model as object
' The Container can either be a whole document or a specific sheet of a Calc-Document
' 'CName' is the name of the Control
Function getControlModel(oContainer as Object, CName as String)
Dim aForm, oForms as Object
Dim i as Integer
oForms = oContainer.Drawpage.GetForms
For i = 0 To oForms.Count-1
aForm = oForms.GetbyIndex(i)
If aForm.HasByName(CName) Then
GetControlModel = aForm.GetbyName(CName)
Exit Function
End If
Next i
Msgbox("No Control with the name '" & CName & "' found" , 16, GetProductName())
End Function
' Gets the Shape of a Control( e. g. to reset the size or Position of the control
' Parameters:
' The 'oContainer' is the Document or a specific sheet of a Calc - Document
' 'CName' is the Name of the Control
Function GetControlShape(oContainer as Object,CName as String)
Dim i as integer
Dim aShape as Object
For i = 0 to oContainer.DrawPage.Count-1
aShape = oContainer.DrawPage(i)
If HasUnoInterfaces(aShape, "com.sun.star.drawing.XControlShape") then
If ashape.Control.Name = CName then
GetControlShape = aShape
exit Function
End If
End If
Next
End Function
' Returns the View of a Control
' Parameters:
' The 'oContainer' is the Document or a specific sheet of a Calc - Document
' The 'oController' is always directly attached to the Document
' 'CName' is the Name of the Control
Function getControlView(oContainer , oController as Object, CName as String) as Object
Dim aForm, oForms, oControlModel as Object
Dim i as Integer
oForms = oContainer.DrawPage.Forms
For i = 0 To oForms.Count-1
aForm = oforms.GetbyIndex(i)
If aForm.HasByName(CName) Then
oControlModel = aForm.GetbyName(CName)
GetControlView = oController.GetControl(oControlModel)
Exit Function
End If
Next i
Msgbox("No Control with the name '" & CName & "' found" , 16, GetProductName())
End Function
' Parameters:
' The 'oContainer' is the Document or a specific sheet of a Calc - Document
' 'CName' is the Name of the Control
Function DisposeControl(oContainer as Object, CName as String) as Boolean
Dim aControl as Object
aControl = GetControlModel(oContainer,CName)
If not IsNull(aControl) Then
aControl.Dispose()
DisposeControl = True
Else
DisposeControl = False
End If
End Function
' Returns a sequence of a group of controls like option buttons or checkboxes
' The 'oContainer' is the Document or a specific sheet of a Calc - Document
' 'sGroupName' is the Name of the Controlgroup
Function GetControlGroupModel(oContainer as Object, sGroupName as String )
Dim aForm, oForms As Object
Dim aControlModel() As Object
Dim i as integer
oForms = oContainer.DrawPage.Forms
For i = 0 To oForms.Count-1
aForm = oForms(i)
If aForm.HasbyName(sGroupName) Then
aForm.GetGroupbyName(sGroupName,aControlModel)
GetControlGroupModel = aControlModel
Exit Function
End If
Next i
Msgbox("No Controlgroup with the name '" & sGroupName & "' found" , 16, GetProductName())
End Function
' Returns the Referencevalue of a group of e.g. option buttons or check boxes
' 'oControlGroup' is a sequence of the Control objects
Function GetRefValue(oControlGroup() as Object)
Dim i as Integer
For i = 0 To Ubound(oControlGroup())
' oControlGroup(i).DefaultState = oControlGroup(i).State
If oControlGroup(i).State Then
GetRefValue = oControlGroup(i).RefValue
exit Function
End If
Next
Msgbox("No Control selected!",16, GetProductName())
End Function
Function GetRefValueOfControlGroup(oContainer as Object, GroupName as String)
Dim oOptGroup() as Object
Dim iRef as Integer
oOptGroup() = GetControlGroupModel(oContainer, GroupName)
iRef = GetRefValue(oOptGroup())
GetRefValueofControlGroup = iRef
End Function
Function GetOptionGroupValue(oContainer as Object, OptGroupName as String) as Boolean
Dim oRulesOptions() as Object
oRulesOptions() = GetControlGroupModel(oContainer, OptGroupName)
GetOptionGroupValue = oRulesOptions(0).State
End Function
Function WriteOptValueToCell(oSheet as Object, OptGroupName as String, iCol as Integer, iRow as Integer) as Boolean
Dim bOptValue as Boolean
Dim oCell as Object
bOptValue = GetOptionGroupValue(oSheet, OptGroupName)
oCell = oSheet.GetCellByPosition(iCol, iRow)
oCell.SetValue(ABS(CInt(bOptValue)))
WriteOptValueToCell() = bOptValue
End Function
Function LoadDialog(Libname as String, DialogName as String, Optional oLibContainer)
Dim oLib as Object
Dim oLibDialog as Object
Dim oRuntimeDialog as Object
If IsMissing(oLibContainer ) then
oLibContainer = DialogLibraries
End If
oLibContainer.LoadLibrary(LibName)
oLib = oLibContainer.GetByName(Libname)
oLibDialog = oLib.GetByName(DialogName)
oRuntimeDialog = CreateUnoDialog(oLibDialog)
LoadDialog() = oRuntimeDialog
End Function
Sub GetFolderName(oRefModel as Object)
Dim oFolderDialog as Object
Dim iAccept as Integer
Dim sPath as String
Dim InitPath as String
Dim RefControlName as String
Dim oUcb as object
'Note: The following services have to be called in the following order
' because otherwise Basic does not remove the FileDialog Service
oFolderDialog = CreateUnoService("com.sun.star.ui.dialogs.FolderPicker")
oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
InitPath = ConvertToUrl(oRefModel.Text)
If InitPath = "" Then
InitPath = GetPathSettings("Work")
End If
If oUcb.Exists(InitPath) Then
oFolderDialog.SetDisplayDirectory(InitPath)
End If
iAccept = oFolderDialog.Execute()
If iAccept = 1 Then
sPath = oFolderDialog.GetDirectory()
If oUcb.Exists(sPath) Then
oRefModel.Text = ConvertFromUrl(sPath)
End If
End If
End Sub
Sub GetFileName(oRefModel as Object, Filternames())
Dim oFileDialog as Object
Dim iAccept as Integer
Dim sPath as String
Dim InitPath as String
Dim RefControlName as String
Dim oUcb as object
'Dim ListAny(0)
'Note: The following services have to be called in the following order
' because otherwise Basic does not remove the FileDialog Service
oFileDialog = CreateUnoService("com.sun.star.ui.dialogs.FilePicker")
oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
'ListAny(0) = com.sun.star.ui.dialogs.TemplateDescription.FILEOPEN_SIMPLE
'oFileDialog.initialize(ListAny())
AddFiltersToDialog(FilterNames(), oFileDialog)
InitPath = ConvertToUrl(oRefModel.Text)
If InitPath = "" Then
InitPath = GetPathSettings("Work")
End If
If oUcb.Exists(InitPath) Then
oFileDialog.SetDisplayDirectory(InitPath)
End If
iAccept = oFileDialog.Execute()
If iAccept = 1 Then
sPath = oFileDialog.Files(0)
If oUcb.Exists(sPath) Then
oRefModel.Text = ConvertFromUrl(sPath)
End If
End If
End Sub
Function StoreDocument(oDocument as Object, FilterNames() as String, DefaultName as String, DisplayDirectory as String) as String
Dim NoArgs() as New com.sun.star.beans.PropertyValue
Dim oStoreProperties(0) as New com.sun.star.beans.PropertyValue
Dim oStoreDialog as Object
Dim iAccept as Integer
Dim sPath as String
Dim ListAny(0) as Long
Dim UIFilterName as String
Dim FilterName as String
Dim FilterIndex as Integer
ListAny(0) = com.sun.star.ui.dialogs.TemplateDescription.FILESAVE_AUTOEXTENSION_PASSWORD_FILTEROPTIONS
oStoreDialog = CreateUnoService("com.sun.star.ui.dialogs.FilePicker")
oStoreDialog.Initialize(ListAny())
AddFiltersToDialog(FilterNames(), oStoreDialog)
oStoreDialog.SetDisplayDirectory(DisplayDirectory)
oStoreDialog.SetDefaultName(DefaultName)
iAccept = oStoreDialog.Execute()
If iAccept = 1 Then
sPath = oStoreDialog.Files(0)
UIFilterName = oStoreDialog.GetCurrentFilter()
FilterIndex = IndexInArray(UIFilterName, FilterNames())
FilterName = FilterNames(FilterIndex,2)
On Local Error Goto NOSAVING
If FilterName = "" Then
' Todo: Den Fall abfangen, wenn ein zu ├╝berschreibendes Dokument schreibgesch├╝tzt ist (weil es z.B. gerade ge├╢ffnet ist)
oDocument.StoreAsUrl(sPath, NoArgs())
Else
oStoreProperties(0).Name = "FilterName"
oStoreProperties(0).Value = FilterName
oDocument.StoreAsUrl(sPath, oStoreProperties())
End If
End If
StoreDocument() = sPath
Exit Function
NOSAVING:
If Err <> 0 Then
' Msgbox("Document cannot be saved under '" & ConvertFromUrl(sPath) & "'", 48, GetProductName())
sPath = ""
Resume NOERROR
NOERROR:
End If
End Function
Sub AddFiltersToDialog(FilterNames() as String, oDialog as Object)
Dim i as Integer
Dim MaxIndex as Integer
Dim ViewFiltername as String
Dim oProdNameAccess as Object
Dim sProdName as String
oProdNameAccess = GetRegistryKeyContent("org.openoffice.Setup/Product")
sProdName = oProdNameAccess.getByName("ooName")
MaxIndex = Ubound(FilterNames(), 1)
For i = 0 To MaxIndex
Filternames(i,0) = ReplaceString(Filternames(i,0), sProdName,"%productname%")
oDialog.AppendFilter(FilterNames(i,0), FilterNames(i,1))
Next i
oDialog.SetCurrentFilter(FilterNames(0,0)
End Sub
Sub SwitchMousePointer(oWindowPeer as Object, bDoEnable as Boolean)
Dim oWindowPointer as Object
oWindowPointer = CreateUnoService("com.sun.star.awt.Pointer")
If bDoEnable Then
oWindowPointer.SetType(com.sun.star.awt.SystemPointer.ARROW)
Else
oWindowPointer.SetType(com.sun.star.awt.SystemPointer.WAIT)
End If
oWindowPeer.SetPointer(oWindowPointer)
End Sub</script:module>